home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / q4tool.zip / Q4T-DEMO.BAS < prev    next >
BASIC Source File  |  1990-06-27  |  21KB  |  463 lines
  1. '----------------------------------------------------------------------------
  2. '                         **    Q4T-DEMO.BAS    **
  3. '      Demonstration of the capabilities of the Q4Tool Library routines
  4. '     Written for and compiled with Microsoft (R), QuickBASIC  4.00b (C)
  5. '                       By R. J. Crouch  -  June 1990
  6. '                      Copyright  -  1990  -  CareWare
  7. '                            All Rights Reserved
  8. '----------------------------------------------------------------------------
  9.  
  10. ' For Q4tool v.1.1
  11.  
  12. REM $INCLUDE: 'Q4T.BI'                            ' Contains declarations for
  13.                                                   '  Ctr() and Delay()
  14. DEFINT A-Z
  15.  
  16. TYPE RegType                                      ' Necessary for the CALL to
  17.    ax    AS INTEGER                               '  the QB's Interrupt()
  18.    bx    AS INTEGER                               '  routine
  19.    cx    AS INTEGER                               '
  20.    dx    AS INTEGER                               ' Generally placed in the
  21.    bp    AS INTEGER                               '  "$INCLUDE:" file
  22.    si    AS INTEGER                               '
  23.    di    AS INTEGER                               '
  24.    flags AS INTEGER                               '
  25. END TYPE                                          '
  26.                                                   
  27. DIM InReg AS RegType, OutReg AS RegType               ' Typed for Interrupt()
  28.  
  29. DIM ScrnBuf(8) AS STRING * 4000                          ' Room for 9 screens
  30.                                                          '  w/ option base 0
  31. FALSE = 0: TRUE = NOT FALSE                                           ' Flags
  32. CONST CONT = "Press any key to continue"                            ' Prompts
  33. CONST MCONT = "Left mouse button to continue"                       '
  34.  
  35. b1$ = CHR$(221) + " ": b2$ = " " + CHR$(222)                       ' Brackets
  36. cpyr$ = b1$ + "Copyright - 1990 - CareWare" + b2$
  37. mpos1$ = b1$ + "Row ## - Col ##" + b2$                         ' Formats for
  38. mpos2$ = b1$ + "Y ###  -  X ###" + b2$                         '  PRINT USING
  39. buttons = 0
  40.  
  41. 'ON KEY(10) GOSUB Terminate                                 ' For programming
  42. 'KEY(10) ON                                                 '  purposes only
  43.  
  44. '----------------------------------------------------------------------------
  45. 'Title Screen
  46. '----------------------------------------------------------------------------
  47.  
  48.    COLOR 0, 1, 0: CLS
  49.    CALL DoWindow(2, 6, 23, 69, 14, 6, 5, 0, "Q4Tool Demo", 2)
  50.    CALL PrtScrn(cpyr$, 24, 25, 110)
  51.    CALL DoWindow(5, 13, 16, 55, 15, 0, 5, 3, CONT, 3)
  52.    FOR row = 7 TO 16
  53.       READ line$: lctr = Ctr(line$)
  54.       IF row < 10 THEN att = 12 ELSE att = 14
  55.       CALL PrtScrn(line$, row, lctr, att)
  56.    NEXT row
  57.    READ line$
  58.    CALL PrtScrn(line$, row + 1, lctr, 10)
  59.    CALL PutScrn(ScrnBuf(0))
  60.    CALL Delay(0, 0)
  61.    CALL MouseStatus(have)                         ' Check for mouse interrupt
  62.    IF have THEN                                            ' Ask to use mouse
  63.       CALL DoWindow(7, 16, 12, 49, 12, 0, 1, 0, "", 0)
  64.       CALL PrtScrn(STRING$(29, 220), 20, 26, 15)
  65.       CALL MouseVersion(ver$)
  66.       FOR row = 9 TO 14
  67.          READ line$: lcrt = Ctr(line$)
  68.          CALL PrtScrn(line$, row, lctr, 14)
  69.          IF row = 10 THEN CALL PrtScrn(ver$, row, lctr + 26, 10)
  70.       NEXT row
  71.       finish! = TIMER + 30
  72.       DO
  73.          i$ = UCASE$(INKEY$)                                   ' Wait for key
  74.          now! = TIMER                                          '  or 30 sec.
  75.       LOOP UNTIL i$ = "N" OR i$ = "Y" OR now! > finish!
  76.       IF i$ = "Y" THEN                              ' Initialize mouse driver
  77.          prompt$ = MCONT: pctr = Ctr(MCONT)                ' Use mouse prompt
  78.          CALL MouseReset(buttons)                       ' Return # of buttons
  79.          mouse = TRUE
  80.       ELSE                                                 ' Mouse not wanted
  81.          prompt$ = CONT: pctr = Ctr(CONT)                    ' Use key prompt
  82.          mouse = FALSE
  83.       END IF
  84.       CALL PrtScrn(prompt$, 16, pctr, 10)
  85.       CALL Delay(30, 0)
  86.    ELSE                                                   ' No mouse detected
  87.       FOR x = 1 TO 6: READ nul$: NEXT x                ' Skip mouse text data
  88.    END IF
  89.    CALL GetScrn(ScrnBuf(0))                         ' Retrieve opening screen
  90.    IF mouse THEN CALL PrtScrn(b1$ + prompt$ + b2$, 20, pctr - 2, 15)
  91.    CALL Delay(60, 0)
  92.    CLS
  93.    CALL DoWindow(8, 14, 9, 53, 13, 0, 5, 3, prompt$, 3)
  94.    FOR row = 11 TO 13
  95.       READ line$: lctr = Ctr(line$)
  96.       CALL PrtScrn(line$, row, lctr, 15)
  97.    NEXT row
  98.    CALL Delay(60, 0)
  99.  
  100. '----------------------------------------------------------------------------
  101. 'Frame types and screen save/restore
  102. '----------------------------------------------------------------------------
  103.  
  104.    COLOR 0, 0, 0: CLS
  105.    col = 0: frm = -1: scrn = -1
  106.    bgd = 0: fgd = 15
  107.    FOR row = 2 TO 14 STEP 3
  108.       col = col + 6: bgd = bgd + 1
  109.       frm = frm + 1: fgd = fgd - 1
  110.       CALL DoWindow(row, col, 10, 20, fgd, bgd, frm, 0, "Window", 2)
  111.       scrn = scrn + 1
  112.       CALL PutScrn(ScrnBuf(scrn))                   ' Screen save w/PutScrn()
  113.    NEXT row
  114.    FOR row = 11 TO 2 STEP -3
  115.       col = col + 6: bgd = bgd + 1
  116.       frm = frm + 1: fgd = fgd - 1
  117.       IF frm = 6 THEN frm = 1
  118.       IF fgd = 9 THEN fgd = 14
  119.       CALL DoWindow(row, col, 10, 20, fgd, bgd, frm, 0, "Q4Tool", 3)
  120.       IF scrn < 8 THEN                             ' Save all but last screen
  121.          scrn = scrn + 1
  122.          CALL PutScrn(ScrnBuf(scrn))             ' Save screens for later use
  123.       END IF
  124.    NEXT row
  125.    FOR row = 3 TO 9
  126.       READ line$
  127.       CALL PrtScrn(line$, row, col + 2, 31)
  128.    NEXT row
  129.    CALL PrtScrn(prompt$, 25, pctr, 10)
  130.    CALL Delay(60, 0)
  131.    CALL DoWindow(9, 12, 7, 56, 15, 0, 5, 0, "", 3)
  132.    FOR row = 11 TO 13
  133.       READ line$: lctr = Ctr(line$)
  134.       CALL PrtScrn(line$, row, lctr, 10)
  135.    NEXT row
  136.    CALL Delay(60, 0)
  137.    FOR show = 7 TO 0 STEP -1
  138.       CALL GetScrn(ScrnBuf(show))                    ' Retrieve saved screens
  139.    NEXT show
  140.    FOR row = 5 TO 7
  141.       CALL PrtScrn("*  Fast  *", row, 11, 16)
  142.    NEXT row
  143.    CALL Delay(2, 0)
  144.    CALL DoWindow(10, 12, 7, 56, 15, 0, 5, 0, prompt$, 3)
  145.    FOR row = 12 TO 13
  146.       READ line$: lctr = Ctr(line$)
  147.       CALL PrtScrn(line$, row, lctr, 10)
  148.    NEXT row
  149.    CALL Delay(60, 0)
  150.    FOR show = 1 TO 8
  151.       CALL GetScrn(ScrnBuf(show))                ' Screen restore w/GetScrn()
  152.       CALL Delay(.33, 0)                         '  .33 second delay added
  153.    NEXT show
  154.    CALL PrtScrn("Now a three", 5, 58, 31)
  155.    CALL PrtScrn("second delay", 7, 58, 31)
  156.    CALL Delay(3, 0)
  157.    FOR show = 8 TO 0 STEP -1
  158.       CALL GetScrn(ScrnBuf(show))
  159.       CALL Delay(.33, 0)
  160.    NEXT show
  161.    CALL DoWindow(2, 6, 10, 20, 4, 7, 5, 0, "Q4Tool", 2)
  162.    CALL PrtScrn("*  Next  *", 5, 11, 112)
  163.    CALL PrtScrn("Shadow Styles", 7, 10, 112)
  164.    CALL PrtScrn(prompt$, 25, pctr, 10)
  165.    CALL Delay(60, 0)
  166.  
  167. '----------------------------------------------------------------------------
  168. 'Shadowing
  169. '----------------------------------------------------------------------------
  170.  
  171.    CLS
  172.    CALL DoWindow(1, 1, 25, 80, 9, 3, 5, 0, prompt$, 3)
  173.    CALL DoWindow(2, 21, 3, 38, 0, 7, 1, 0, "", 0)
  174.    CALL DoWindow(6, 41, 18, 35, 1, 1, 0, 0, "", 0)
  175.    READ line$: lctr = Ctr(line$)
  176.    CALL PrtScrn(line$, 3, lctr, 117)
  177.    FOR row = 7 TO 16 STEP 9
  178.       FOR col = 8 TO 43 STEP 35
  179.          shadow = shadow + 1: back = back + 1
  180.          CALL DoWindow(row, col, 7, 30, 14, back, back, shadow, "", 0)
  181.          FOR x = row + 2 TO row + 4
  182.             READ line$
  183.             CALL PrtScrn(line$, x, col + 5, back * 16)
  184.          NEXT x
  185.       NEXT col
  186.       back = back + 1
  187.    NEXT row
  188.    CALL PutScrn(ScrnBuf(0))
  189.    CALL Delay(60, 0)
  190.    CALL DoWindow(8, 9, 10, 62, 14, 0, 5, 0, prompt$, 3)
  191.    FOR row = 10 TO 14
  192.       READ line$: lctr = Ctr(line$)
  193.       IF row < 12 THEN att = 15 ELSE att = 10
  194.       CALL PrtScrn(line$, row, lctr, att)
  195.    NEXT row
  196.    CA